home *** CD-ROM | disk | FTP | other *** search
/ The Best of MacTutor - S…e Code for Volumes 1 to 5 / The Best of MacTutor - Source Code for Volume 1-5 (Wayzata Technology)(6031)(1990).bin / Source Code / #44 (May 89) / Sound Stuff / SoundPlayer.text < prev   
Text File  |  1989-02-26  |  7KB  |  315 lines
  1. ' SoundPlayer
  2. ' Plays digitized sounds from snd resources
  3. ' and sound data files using
  4. ' MicroSoft QuickBasic 1.0
  5. ' by Ron Butcher 2/6/89
  6. CLEAR, 100000&
  7. DIM Paramblock%(39),scr%(3),bar%(3),pt%(2),r%(3)
  8. DIM PHS$(200),id%(200)
  9. DIM Reg&(5)
  10. ' Trap calls
  11. RITE%=&HA003:Ohpen%=&HA000
  12. Dread%=&HA002:Klose%=&HA001:GetEOF%=&HA011
  13. NewPtr%=&HA01E : DisposePtr%=&HA01F
  14. 'Initialize variables and constants
  15. FFsynthPtr&=0:Param&=0:Siz&=0:h&=0:S&=0:ResH&=0
  16. oldbut%=0:butnum%=0:Tag&=0:state%=0
  17. x0%=0:y0%=0:y%=0:x%=0
  18. true%=-1:false%=0:GotPointer%=false%:er%=0
  19. MenuItem%=0:MenuChoice%=0
  20. ForkOpen%=false%:gotresource%=false%
  21. num%=2:num1%=0:ref%=0:id%=0:action%=0
  22. type$="snd ":nam$="":F$="":G$="":pic$=""
  23. lfd&=0:I=0:count&=0:resid%=0
  24. TwentyTwoK&=&H10000& ' count values
  25. ElevenK&=&H8000&
  26. SevenK&=&H5555&
  27. FiveK&=&H4000&
  28. ToolBox "i"
  29. WINDOW CLOSE 1
  30. MENU 1,0,1,"File"
  31. MENU 1,1,1,"Open Sound Data"
  32. MENU 1,2,1,"Open Sound Resource"
  33. MENU 1,3,0,"Draw Sound Graph"
  34. MENU 1,4,1,"Quit"
  35. CmdKey 1,1,"D"
  36. CmdKey 1,2,"R"
  37. CmdKey 1,3,"G"
  38. CmdKey 1,4,"Q"
  39. Sheight=SYSTEM(6)
  40. Swidth=SYSTEM(5)
  41. WINDOW 2,"",(50,100)-(Swidth-32,Sheight-77),3
  42. BUTTON 1,1,"22 KHz",(25,25)-(100,40),3
  43. BUTTON 2,2,"11 KHz",(25,60)-(100,75),3
  44. BUTTON 3,1,"7.4 KHz",(25,95)-(100,110),3
  45. BUTTON 4,1,"5.5 KHz",(25,130)-(100,145),3
  46. BUTTON 5,0,"Play",(130,75)-(190,100)
  47. SetRect scr%(0),200,6,400,158
  48. SetRect bar%(0),399,6,415,158
  49. r%(0)=75
  50. r%(1)=130
  51. r%(2)=100
  52. r%(3)=190
  53. inSetRect r%(0),-4,-4
  54. oldbut%=2:count&=ElevenK&
  55. linenum%=0:top%=0:S&=0:in%=0
  56. NewScroll S&,bar%(0),1,1,1,1
  57. InactiveScroll S&
  58. PICTURE ON
  59. PENSIZE 3,3
  60. FRAMEROUNDRECT VARPTR(r%(0)),16,16
  61. PENNORMAL
  62. ERASERECT VARPTR(scr%(0))
  63. FRAMERECT VARPTR(scr%(0))
  64. PICTURE OFF
  65. pic$=PICTURE$
  66. PICTURE ON : PICTURE OFF
  67. refresh
  68.  
  69. ON MENU GOSUB MenSelect : MENU ON
  70. ON DIALOG GOSUB ChoiceWait : DIALOG ON
  71.  
  72. UserWait:
  73. WHILE true%
  74.  hittest
  75.  ScrollText S&,scr%(0),PHS$(1),top%,num1%,linenum%,3
  76. WEND
  77.  
  78. ChoiceWait:
  79. MENU STOP : MOUSE STOP
  80. action%=DIALOG(0)
  81. IF action%=5 THEN CALL refresh
  82. IF action%<>1 THEN
  83.   MENU ON : MOUSE ON
  84.   RETURN
  85. END IF
  86. ON action% GOSUB HandleButton
  87. MENU ON : MOUSE ON
  88. RETURN
  89.  
  90. HandleButton:
  91. butnum%=DIALOG(1)
  92. IF butnum%=oldbut% THEN RETURN
  93. IF butnum% <> 5 THEN
  94.   BUTTON butnum%,2
  95.   BUTTON oldbut%,1
  96.   oldbut%=butnum%
  97. END IF
  98. SELECT CASE butnum%
  99.   CASE 1
  100.     count&=TwentyTwoK&
  101.   CASE 2
  102.     count&=ElevenK&
  103.   CASE 3
  104.     count&=SevenK&
  105.   CASE 4
  106.     count&=FiveK&
  107.   CASE 5
  108.     GOSUB writefork
  109. END SELECT
  110. RETURN
  111.  
  112. openDataFile:
  113. F$=FILES$(1,"FSSD"):IF F$="" THEN RETURN
  114. BUTTON 5,0
  115. gotresource% = false%
  116. IF ForkOpen% THEN
  117.     GOSUB CleanItUp
  118.     ForkOpen%=false%
  119. END IF
  120. PtrTest
  121. GOSUB ReadFork
  122. Tag&=PEEKL(FFsynthPtr&+6) '"HCOM"
  123. IF Tag&=1212370765& THEN BEEP:RETURN 'compressed
  124. BUTTON 5,1
  125. RETURN
  126.  
  127. openResFile:
  128. F$=FILES$(1,"SFILSTAK"):IF F$="" THEN RETURN
  129. BUTTON 5,0
  130. PtrTest
  131. in%=0:top%=0:linenum%=0:resid%=0
  132. GOSUB CountResources
  133. GOSUB ClearBuffer
  134. RETURN
  135.  
  136. Quit:
  137. IF ForkOpen% THEN GOSUB CleanItUp
  138. PtrTest
  139. DisposeScroll S&
  140. WINDOW CLOSE 2
  141. END
  142.  
  143. MenSelect:
  144. MenuItem%=MENU(0)
  145. IF MenuItem% <>1 THEN RETURN
  146. MenuChoice%=MENU(1)
  147. MENU
  148. ON MenuChoice% GOSUB openDataFile,openResFile,Drawgraph,Quit
  149. RETURN
  150.  
  151. writefork:
  152. IF gotresource% THEN GOSUB LoadResource
  153. POKEW FFsynthPtr&,0 '0 for ffmode
  154. POKEL FFsynthPtr&+2,count& 'sizing value
  155. Param&=VARPTR(Paramblock%(0))
  156. POKE Param&+27,0       'reset permission
  157. POKEW Param&+24,&HFFFC 'Sound Driver refnum
  158. POKEL Param&+36,lfd&   'length to write
  159. POKEW Param&+44,0      'ioPosMode
  160. POKEL Param&+46,0      'ioPosOffSet
  161. POKEL Param&+32,FFsynthPtr& 'address of synthrec
  162. ToolBox "R",RITE%,Reg&(0),(Param&) ' call _Write
  163. RETURN
  164.  
  165. ReadFork:
  166. GOSUB ClearBuffer
  167. B2PStr F$,G$
  168. Param&=VARPTR(Paramblock%(0))
  169. POKEL Param&+18,SADD(G$) 'address of filename
  170. POKE Param&+27,1         'read only
  171. ToolBox "R",Ohpen%,Reg&(0),(Param&)  'call _Open
  172. ToolBox "R",GetEOF%,Reg&(0),(Param&) 'call _GetEOF
  173. Param&=VARPTR(Paramblock%(0))
  174. lfd&=PEEKL(Param&+28) 'file length
  175. IF lfd& =0 THEN       'No data
  176.   ToolBox "R",Klose%,Reg&(0),(Param&)
  177.   BEEP : RETURN
  178. END IF
  179. Siz&=lfd&+6              '6 bytes for mode and count
  180. GOSUB GetPointer
  181. Param&=VARPTR(Paramblock%(0))
  182. POKEL Param&+36,lfd&        'number of bytes to read
  183. POKEL Param&+32,FFsynthPtr&+6 'block address
  184. POKEW Param&+44,1 'ioPosMode read from start of file 
  185. ToolBox "R",Dread%,Reg&(0),(Param&) 'call _Read
  186. ToolBox "R",Klose%,Reg&(0),(Param&) 'call _Close
  187. RETURN
  188.  
  189. GetPointer:
  190. 'Get block of Siz& bytes and
  191. 'return address in FFsynthPtr&
  192. ToolBox "R",NewPtr%,Reg&(0),,,(Siz&) 'call _NewPointer
  193. GotPointer%=true%
  194. FFsynthPtr&=Reg&(0)
  195. RETURN
  196.  
  197. LoadResource:
  198. IF resid%=id%(linenum%) THEN RETURN
  199. PtrTest
  200. 'Get the resource
  201. GetRes ref%,type$,id%(linenum%),h&
  202. resid%=id%(linenum%)
  203. HLock h&
  204. GetHandleSize h&,lfd&
  205. Siz&=lfd&
  206. GOSUB GetPointer
  207. 'coerce pointer
  208. ResH&=PEEKL(h&)
  209. BlockMove ResH&,FFsynthPtr&,Siz&
  210. Hunlock h&
  211. ReleaseRes h&
  212. RETURN
  213.  
  214. CountResources:
  215. IF ForkOpen% THEN GOSUB CleanItUp:ForkOpen%=false%
  216. PtrTest
  217. CountRes type$,num%        'number in System
  218. ToolBox "WQ",&H997,F$,ref% 'openresfile
  219. ForkOpen%=true%
  220. updateresfile ref%
  221. CountRes type$,num1%
  222. num1%=num1%-num%           'number of type snd     
  223. GOSUB GetResources
  224. RETURN
  225.  
  226. GetResources:
  227. 'set ResLoad to false
  228. POKEW &HA5E,0 'comment out for interpreter
  229. FOR ind%=1 TO num1%
  230.   GetIndRes type$,ind%,h&
  231.   GetResInfo h&,id%(ind%),type$,nam$
  232.   ReleaseRes h&
  233.   PHS$(ind%)=nam$+" - "+STR$(id%(ind%))
  234.   NEXT ind%
  235. 'set ResLoad to true
  236. POKEW &HA5E,-1 'comment out for interpreter
  237. gotresource%=true%
  238. ActiveScroll S&
  239. RETURN
  240.  
  241. ClearBuffer:
  242. Param&=VARPTR(Paramblock%(0))
  243. FOR I=0 TO 79: POKE Param&+I,0: NEXT I
  244. RETURN
  245.  
  246. CleanItUp:
  247. CloseResfile ref%
  248. InactiveScroll S&
  249. in%=0:top%=0:linenum%=0:resid%=0:num1%=0
  250. RETURN
  251.  
  252. Drawgraph:
  253. DIALOG STOP :MENU OFF
  254. WINDOW 3,"",(0,20)-(Swidth,Sheight),3
  255. MOVETO 0,0
  256. inc=lfd&\Swidth
  257. x0%=0:y0%=0:y%=0:x%=0
  258. FOR I=1 TO lfd& STEP inc
  259.   LINETO x0%,y%
  260.   y%=PEEK(FFsynthPtr&+(I))
  261.   y%=(128-y%)+128 'Invert it
  262.   PSET (x%,y%)
  263.   x0%=x%
  264.   x%=x%+1
  265. NEXT I
  266. TEXTFONT 0
  267. MOVETO 180,300
  268. DrawText "Click Mouse to Continue"
  269. TEXTFONT 1
  270. WHILE MOUSE(0)=0:WEND
  271. WINDOW CLOSE 3
  272. WINDOW 2
  273. DIALOG ON:MENU ON
  274. RETURN
  275.  
  276. SUB hittest STATIC
  277. SHARED scr%(),pt%(),num1%,linenum%,gotresource%
  278. in%=0
  279. IF NOT gotresource% THEN EXIT SUB
  280. IF MOUSE(0)=1 THEN
  281.   GetMouse pt%(1)
  282.   PtInRect pt%(1),scr%(0),in%
  283.     IF in% THEN
  284.       found
  285.     END IF
  286.     IF linenum%<>0 AND linenum%<=num1% THEN
  287.       state%=1 
  288.     ELSE
  289.       state%=0
  290.     END IF
  291.   BUTTON 5,state%
  292.   refresh
  293. END IF
  294. END SUB
  295.  
  296. SUB found STATIC
  297. SHARED linenum%,num1%,top%,pt%(),scr%()
  298.  linenum%=top%+(pt%(1)-scr%(0))\20
  299. END SUB
  300.  
  301. SUB refresh STATIC
  302. SHARED scr%(),PHS$(),S&,num1%,linenum%,pic$
  303. PICTURE,pic$
  304. top%=0
  305. ScrollText S&,scr%(0),PHS$(1),top%,num1%,linenum%,3
  306. END SUB
  307.  
  308. SUB PtrTest STATIC
  309. SHARED GotPointer%,Reg&(),FFsynthPtr&
  310. DisposePtr%=&HA01F
  311. IF GotPointer% THEN  'call _DisposePointer
  312.   CALL ToolBox("R",DisposePtr%,Reg&(0),(FFsynthPtr&))
  313.   GotPointer%=0
  314. END IF
  315. END SUB